home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / simula / books / books.lha / kirkerud / dates.sim < prev    next >
Text File  |  1993-08-16  |  6KB  |  184 lines
  1. begin
  2.  
  3. % *****************************************
  4. % *                                       *
  5. % *   Proposed solution to exercise 6.7:  *
  6. % *                                       *
  7. % *****************************************
  8.  
  9.   procedure prompt_for_date(prompt, year, month, day);
  10.       name year, month, day;
  11.       text prompt; integer year, month, day;
  12.     begin
  13.       outtext(prompt);
  14.       year  := prompt_for_int(" Year? ");
  15.       month := prompt_for_int(" Month? ");
  16.       day   := prompt_for_int(" Day? ");
  17.     end;
  18.  
  19. % An auxiliary procedure used in the procedure prompt_for_date:
  20.  
  21.   integer procedure prompt_for_int(prompt); text prompt;
  22.     begin
  23.       outtext(prompt); breakoutimage; inimage;
  24.       prompt_for_int := inint;
  25.     end;
  26.  
  27.  
  28. % *****************************************
  29. % *                                       *
  30. % *   Proposed solution to exercise 6.9:  *
  31. % *                                       *
  32. % *****************************************
  33.  
  34.   Boolean procedure leap_year(year); integer year;
  35.     leap_year := mod(year, 4) = 0 and 
  36.         (mod(year, 100) ne 0 or mod(year, 400) = 0); 
  37.  
  38.  
  39. % ********************************************
  40. % *                                          *
  41. % *   Proposed solution to exercise 6.10.a:  *
  42. % *                                          *
  43. % ********************************************
  44.  
  45.   procedure date(year, day_in_year, legal_date, month, day_in_month);
  46.       name    legal_date, month, day_in_month;
  47.       integer year, day_in_year, month, day_in_month;
  48.       Boolean legal_date;
  49.     begin Boolean month_found;  
  50.       if day_in_year < 1 or day_in_year > 366 or
  51.            (not leap_year(year) and day_in_year = 366) 
  52.          then legal_date := false
  53.       else begin
  54.         legal_date  := true;
  55.         month_found := false; 
  56.         month := 1;
  57.         while not month_found do
  58.           if month_start(month) + month_length(month) > day_in_year 
  59.             then month_found := true
  60.             else month := month + 1;
  61.         day_in_month := day_in_year - month_start(month) + 1;
  62.       end;
  63.     end of date;
  64.  
  65. % Auxiliary arrays (used in the procedure date above):
  66.  
  67.   integer array month_length, month_start(1 : 12);
  68.  
  69. % A procedure that initializes these two arrays:
  70.  
  71.   procedure Set_months(year); integer year;
  72.     begin integer m;
  73.       month_length( 1) := 31;  
  74.       month_length( 2) := if leap_year(year) then 29 else 28;
  75.       month_length( 3) := 31; month_length( 4) := 30;  
  76.       month_length( 5) := 31; month_length( 6) := 30;  
  77.       month_length( 7) := 31; month_length( 8) := 31;  
  78.       month_length( 9) := 30; month_length(10) := 31;  
  79.       month_length(11) := 30; month_length(12) := 31;  
  80.       month_start(1) := 1; 
  81.       for m := 2 step 1 until 12 do 
  82.         month_start(m) := month_start(m - 1) + month_length(m - 1);
  83.     end;
  84.  
  85. % A procedure that tests the procedure date above:   ;
  86.  
  87.   procedure test_date;
  88.     begin 
  89.       integer year, y_day, month, m_day;
  90.       Boolean day_ok;
  91.       outtext("Test of ""date"": ");
  92.       year   := prompt_for_int("Year? "); Set_months(year);
  93.       y_day  := prompt_for_int("Day? ");
  94.       date(year, y_day, day_ok, month, m_day);
  95.       if not day_ok 
  96.         then outtext("Impossible day!")
  97.         else begin
  98.             outtext("That is day number "); write_int(m_day);
  99.             outtext(" in month number ");   write_int(month);
  100.             outtext(" in the year ");       write_int(year);
  101.           end;
  102.       outimage;
  103.     end;
  104.  
  105. % An auxiliary procedure used in the procedure test_date:
  106.  
  107.   procedure write_int(num); integer num;
  108.     begin integer numlen, i;
  109.       numlen := if num le 0 then 1 else 0;
  110.       i := abs(num);
  111.       while i > 0 do 
  112.         begin numlen := numlen + 1; i := i//10 end;
  113.       outint(num, numlen);
  114.     end;
  115.  
  116.  
  117.  
  118. % ********************************************
  119. % *                                          *
  120. % *   Proposed solution to exercise 6.10.c:  *
  121. % *                                          *
  122. % ********************************************
  123.  
  124.   procedure opposite_of_date(year, month, day_in_month, legal_date, day_in_year);
  125.       name legal_date, day_in_year;
  126.       integer year, month, day_in_month, day_in_year;
  127.       Boolean legal_date;
  128.      begin
  129.        if month < 1 or else month > 12 
  130.          or else day_in_month < 1 or else day_in_month > month_length(month)
  131.        then legal_date := false
  132.        else begin
  133.            legal_date := true;
  134.            day_in_year := month_start(month) + day_in_month - 1;
  135.          end;
  136.      end of opposite_of_date;
  137.  
  138. % A procedure that tests the procedure opposite_of_date above:
  139.  
  140.   procedure test_opposite_of_date;
  141.     begin
  142.       integer year, y_day, month, m_day;
  143.       Boolean day_ok;
  144.       outtext("Test of ""opposite_of_date"": ");
  145.       year   := prompt_for_int("Year? "); Set_months(year);
  146.       month  := prompt_for_int("Month? ");
  147.       m_day  := prompt_for_int("Day? ");
  148.       opposite_of_date(year, month, m_day, day_ok, y_day);
  149.       if not day_ok then
  150.           outtext("Impossible day!")
  151.       else begin
  152.           outtext("That is day number "); write_int(y_day);
  153.           outtext(" in the year ");       write_int(year);
  154.         end;
  155.       outimage;
  156.     end;
  157.  
  158.  
  159.  
  160. % *********************************************
  161. % *                                           *
  162. % *   Proposed solution to exercise 6.7b, d:  *
  163. % *                                           *
  164. % *********************************************
  165.  
  166.   Boolean more_testing; character c;
  167.  
  168.   outtext("Test of the procedures ""date"" and ""opposite_of_date"".");
  169.   outimage;
  170.   more_testing := true;
  171.   while more_testing do
  172.     begin 
  173.       outtext("Type d for oate-test, o for opposite_of_date-test, "
  174.               "q for quit> "); breakoutimage; 
  175.       inimage; c := inchar;
  176.       if c = 'd' then test_date else
  177.       if c = 'o' then test_opposite_of_date else
  178.       if c = 'q' then more_testing := false;
  179.     end;
  180.   outtext("Bye"); outimage;
  181.  
  182. end
  183.  
  184.